home *** CD-ROM | disk | FTP | other *** search
/ Aminet 38 / Aminet 38 (2000)(Schatztruhe)[!][Aug 2000].iso / PPaint / ColorType / Rexx / FontPics.ctrx < prev    next >
Text File  |  1996-04-11  |  2KB  |  102 lines
  1. /* ColorType Amiga Rexx script - Copyright © 1996 Cloanto Italia srl */
  2.  
  3. /* $VER: FontPics.ctrx 1.0 */
  4.  
  5. /**
  6.  This script scans the user-specified path and, for each font in that
  7.  path, creates an IFF-ILBM image showing all characters in the font.
  8.  
  9.  The resulting images are identical to those generated by ColorType's
  10.  "Show Font" function.
  11. */
  12.  
  13. IF ARG(1, EXISTS) THEN
  14.     PARSE ARG CTPORT
  15. ELSE
  16.     CTPORT = 'COLORTYPE'
  17.  
  18. IF ~SHOW('P', CTPORT) THEN DO
  19.     IF EXISTS('ColorType:ColorType') THEN DO
  20.         ADDRESS COMMAND 'Run >NIL: ColorType:ColorType'
  21.         DO 30 WHILE ~SHOW('P',CTPORT)
  22.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  23.         END
  24.     END
  25.     ELSE DO
  26.         SAY "ColorType could not be loaded."
  27.         EXIT 10
  28.     END
  29. END
  30.  
  31. IF ~SHOW('P', CTPORT) THEN DO
  32.     SAY 'ColorType Rexx port could not be opened.'
  33.     EXIT 10
  34. END
  35.  
  36. ADDRESS VALUE CTPORT
  37. OPTIONS RESULTS
  38. OPTIONS FAILAT 10000
  39.  
  40.  
  41. LockGUI
  42. RequestFont '"Select the Font Path"'
  43. IF RC = 0 THEN DO
  44.     PARSE VALUE RESULT WITH '"' font_path '"'
  45.     RequestPath '"Select the Image Path"'
  46.     IF RC = 0 THEN DO
  47.         PARSE VALUE RESULT WITH '"' image_path '"'
  48.         NewFont
  49.         IF RC = 0 THEN DO
  50.             ListFonts '"'font_path'"'
  51.             IF RC = 0 THEN DO
  52.                 fontlist = RESULT
  53.                 tmpfname = 'T:ctrx_temp.'PRAGMA('ID')
  54.                 IF OPEN('listfile', tmpfname, W) THEN DO
  55.                     WRITECH('listfile', fontlist)
  56.                     CALL CLOSE('listfile')
  57.                     IF OPEN('listfile', tmpfname, R) THEN DO
  58.                         errcode = 0
  59.                         DO FOREVER
  60.                             curfont = READLN('listfile')
  61.                             IF EOF('listfile') THEN BREAK
  62.                             LoadFont FORCE '"'font_path'"' NAME curfont
  63.                             IF RC = 0 THEN DO
  64.                                 PARSE VALUE curfont WITH '"' fontname '"' fontsize fontstyle .
  65.                                 imgname = image_path
  66.                                 IF RIGHT(image_path,1) ~= ':' THEN
  67.                                     imgname = imgname || '/'
  68.                                 imgname = imgname || fontname'_'fontsize
  69.                                 IF LENGTH(fontstyle) ~= 0 THEN
  70.                                     imgname = imgname'_'fontstyle
  71.                                 SaveFontImage '"'imgname'.pic"'
  72.                                 IF RC ~= 0 THEN DO
  73.                                     errcode = RC
  74.                                     IF RC = 5 THEN
  75.                                         errmess = 'User abort during save.'
  76.                                     ELSE
  77.                                         errmess = 'Error 'RC' during save.'
  78.                                 END
  79.                             END
  80.                             ELSE DO
  81.                                 errcode = RC
  82.                                 IF RC = 5 THEN
  83.                                     errmess = 'User abort during load.'
  84.                                 ELSE
  85.                                     errmess = 'Error 'RC' during load.'
  86.                             END
  87.                         END
  88.                         CALL CLOSE('listfile')
  89.  
  90.                         IF errcode > 0 THEN DO
  91.                             SAY errmess
  92.                             RequestNotify 'PROMPT="'errmess'"'
  93.                         END
  94.                     END
  95.                     ADDRESS COMMAND 'Delete >NIL: 'tmpfname
  96.                 END
  97.             END
  98.         END
  99.     END
  100. END
  101. UnlockGUI
  102.